--# -path=.:prelude:alltenses
concrete SyllogismGer of Syllogism = LexiconSyllGer **
   open StructuralGer, IrregGer, ResGer, Prelude in{
  flags coding=utf8 ;

  param WClass = IsNoun | IsVerb | IsAdj | IsPhrase;
  param PClass = Single | Conjunct | Disjunct;  

 
 lincat Syllogism = {s : Str};
        Sentence  = {s : Str};
        Subject   = {s : Number => Str; g : Gender};
        Property  = {s : Number => Polarity => Gender => Str;
                     c : PClass};
        PropertyPart = {s : Either => Number => Polarity => Gender =>  Str;
                           c : WClass; lock_PropertyPart : {} }; 
        Word = {sub : Number => Str;
                prop : Either => Number => Polarity => Gender => Str;
                g: Gender;c : WClass  };
 
        Conclusion = {s : Str};
        Constant  = {s : Str};
        Sentence  = {s : Str};
        Sentences  = {s : Str};
        Const = {s : Str};
        AllQ  = {s : Str; n : Number}; 
        NoQ   = {s : Gender => Str; n : Number};
 lin
   AWord a = {sub = (adjToSub a).s;  prop = (adjToProp a).s; g = Neutr;
              c = IsAdj};
   NWord n = {sub = (nounToSub n).s; prop = (nounToProp n).s; g = n.g;
              c = IsNoun};
   VWord v ={sub = (verbToSub v).s;  prop = (verbToProp v).s; g = Neutr;
             c = IsVerb};

   CWord c = {s = c.s ! Nom};

   CpP const prop = {s = const.s ++ prop.s ! Sg ! Pos ! Neutr };
   CnP const prop = {s = const.s ++ prop.s ! Sg ! Neg ! Neutr};

   SaP allq sub prop = {s = allq.s ++ sub.s ! allq.n ++
                             prop.s ! allq.n ! Pos !  sub.g};
   SoP sub prop = {s = some_Det ++ sub.s ! Pl ++ prop.s ! Pl ! Neg ! sub.g};
   SeP noq sub prop = let quant = sepq sub prop noq in
                  {s = quant.s ++ sub.s ! quant.n 
                                 ++ prop.s ! quant.n ! quant.p ! sub.g};
   SiP sub prop = {s = some_Det ++ sub.s ! Pl ++ prop.s ! Pl !Pos ! sub.g};
   ToProperty sWord = mkProp sWord ** {c = Single};  
   ToSubject  sWord = {s = sWord.sub; g = sWord.g};
   ToConstant cWord = cWord;
   ToPropertyPart word = {s = word.prop; c = word.c} 
                                  ** {lock_PropertyPart = <>};  

   ToConclusion sent = sent | {s = isItTrue ++ sent.s};

   SPhrase a n = {s = (phrToSub a n).s; g = n.g};
   PPhrase a n = {s = (phrToProp a n).s; c = Single};  

   All = variants {{s = "Alle"; n = Pl}; {s = "Jeder,"; n = Pl}};
   No = {s = table {Fem =>"Keine"; Masc => "Kein";
                              Neutr => "Kein"}; n = Sg};


   mkSyllogism ps c = {s = "(" ++ ps.s ++ ") ->" ++ c.s };

   mkSentences  s1 s2 = {s = s1.s ++ "+" ++ s2.s};
   appSentences s1 ss = {s = s1.s ++ "+" ++ ss.s};
   And p1 p2 = {s = \\num,pol,gen => propAnd p1 p2 num pol gen;
                c = Conjunct} ; 
   Or  p1 p2 = {s = \\num,pol,gen => propOr p1 p2 num pol gen;
                c = Disjunct};  


--------OPERATIONS--------------------------------------------------

 {-
   The parameter Either works like a placeholder in a property which tells
   where to insert either/neither/both/not.
   NorS is for the second part of a dis/conjunction and gives the phrase 
   whithout "is" or "does" (eg. "a laptop").
   NoneS is for phrases without any of these words. 
 -}
 param Either  = NotS | NeitherS | EitherS | NorS | NoneS | BothS
                 | BothNS | BothPS ;
  
 oper
  notStr : Either -> Str =
   \not -> case not of {
     NotS => "nicht";
     NeitherS => "weder";
     EitherS => "entWeder";
     NorS    => "";
     BothS   => "sowohl";
     BothPS  => "auch";
     BothNS  => "auch nicht";
     NoneS   => ""};  
   
  isItTrue : Str = "ist es wahr, dass";
 
  -- creates a Property from a PropertyPart
  mkProp : PropertyPart -> {s : Number => Polarity => Gender => Str} =
    \w ->
     {s = \\n => table {Neg => \\g => w.s ! NotS ! n ! Neg ! g;
                        _    => \\g => w.s ! NoneS ! n ! Pos ! g}};


 be : Number -> Str = \n ->  sein_V.s ! VFin True (VPresInd n P3); 

  -- operations for creating Words out of adjectives, nouns and verbs
  adjToProp : A -> {s : Either => Number => Polarity => Gender => Str}
   =  \wor -> 
   { s  = table {NorS => \\n,_,g => wor.s ! Posit ! APred ; 
                 not  => 
       \\n,_,g => be n ++ notStr not ++ wor.s ! Posit ! APred}
    } ;   

  adjToSub : A -> {s : Number => Str} = \adj -> 
     { s = \\n  =>  that ! n ++ adj.s ! Posit ! APred ++ be n ++ ","};
       

  nounToSub : N -> {s : Number => Str } = \wor -> 
     { s = \\num => wor.s ! num !  Nom}; 


  nounToProp : N -> { s : Either => Number => Polarity => Gender => Str }
       = \wor -> 
     { s = table{
         NorS => \\n,_,g => artIndef ! n ! wor.g ++ wor.s ! n ! Nom;
         not => 
            \\n,_,_ => be n ++ notStr not 
                         ++ artIndef ! n ! wor.g  ++ (wor.s ! n ! Nom)}}  ; 

  artIndef : Number => Gender => Str = table{
   Pl => \\_ => "";
   Sg => table {Fem => "eine"; Masc => "ein"; Neutr => "ein"}};

  verbToSub :  V -> {s: Number => Str}
   = \wor ->
   { s = \\n => that ! n ++ wor.s ! vform n ++ ","};  


  verbToProp : V -> { s : Either => Number => Polarity => Gender => Str} 
   = \wor ->    
    { s = table{
     NorS => \\n,_,_ => wor.s ! vform n;
     NotS => \\n => table {Neg => \\_ => wor.s ! vform n ++ notStr NotS; 
                           _    => \\_ => wor.s ! vform n};
     either => \\n,_,_ => notStr either ++ wor.s! vform n}};

  vform : Number -> VForm = \n -> VFin False (VPresInd n P3);
  aform : Number -> Gender -> AForm = 
    \n,g -> case n of { Sg => AMod (GSg g) Nom; Pl => AMod GPl Nom}; 

  that : Number => Str =  table {Sg => "der"; Pl => "die"};


-- operations for creating Words out of phrases like 'en blå blomma'
  phrToSub : A -> N -> {s : Number => Str} =
    \a, n -> 
    {s = \\num => a.s ! Posit ! aform num (n.g) ++ n.s ! num ! Nom};

  phrToProp : A -> N -> {s : Number => Polarity=> Gender => Str} =
    \a, n ->
      {s = \\num => table{
         Neg => \\_ =>  be num ++ notStr NotS ++ artIndef ! num ! n.g 
                ++ a.s ! Posit ! aform num n.g ++ n.s ! num ! Nom;
         _    => \\_ => be num ++ artIndef ! num ! n.g 
                ++ a.s ! Posit ! aform num n.g  ++ n.s ! num ! Nom}}; 

  -- operations for conjuctions 
  -- possible better to say "brennen sowohl als auch schlafen"
  --                        "ist blau sowohl als auch ein Fuss"
  propAnd : PropertyPart -> PropertyPart -> Number -> Polarity 
                                                    -> Gender -> Str =
    \word1, word2, num, pol, gen ->
     let begin = (word1.s ! polarityW1 pol ! num ! pol ! gen ++ und ! pol) in
         case sameClass word1.c word2.c of {
           True  => begin ++ "auch" 
                    ++  word2.s ! polarityW2 pol True ! num ! pol ! gen ;
           False => begin ++ word2.s ! polarityW2 pol False ! num ! pol ! gen
         };

  polarityW1 : Polarity -> Either = 
     \pol -> case pol of{
          Neg => NotS;
          _    => BothS};

  polarityW2 : Polarity -> Bool -> Either = 
     \pol, b -> case pol of{
          Neg =>  NotS;  
          _    => case b of { True =>  NorS; False => NoneS}};

  -- operations for disjuction 
  propOr : PropertyPart -> PropertyPart -> Number -> 
                  Polarity -> Gender -> Str
      = \word1, word2, num, pol, gen ->
     case pol of {
         Pos => combineDisj word1 word2 num Pos gen EitherS "oder";
         _    => combineDisj word1 word2 num Pos gen NeitherS "noch" 
      };
 

  combineDisj : PropertyPart -> PropertyPart -> Number ->
          Polarity -> Gender -> Either -> Str -> Str
   = \word1, word2, num, pol, gen, not,oder -> 
     let begin = word1.s ! not ! num ! pol ! gen ++ oder  in
    case sameClass word1.c word2.c of{
      True => begin ++ word2.s ! NorS ! num ! pol ! gen;
      False => begin ++ word2.s ! NoneS ! num ! pol ! gen
  }; 

-- for seeing how two words can be combined
  sameClass : WClass -> WClass -> Bool =
   \c1, c2 -> case c1 of{
     IsVerb => case c2 of{ IsVerb => True;
                           _       => False};
      _     => case c2 of{ IsVerb => False;
                            _      => True}};

 some_Det : Str =
  "Einige";

 und : Polarity => Str = table {Pos => "als"; Neg => "und"};

 sepq : Subject -> Property -> NoQ -> {s : Str; n : Number; p : Polarity} =
   \sub,p,no -> case p.c of 
          {Disjunct => {s = "Alle"; n = Pl; p = Neg};
           _        => {s = no.s ! sub.g ;  n = no.n; p = Pos}};
}

